home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
BBS Toolkit
/
BBS Toolkit.iso
/
rbbs_pc
/
disring7.zip
/
DISRNG74.MRG
< prev
Wrap
Text File
|
1992-07-01
|
15KB
|
269 lines
* ------------[ BLED merge (c) Ken Goosens ]-------------
* Merge this against rbbssub2.bas to produce rbbs1742.bas
* rbbssub2.bas: Date 6-20-1992 Size 140946 bytes
* ------------[ Created 07-01-1992 09:40:10 ]------------
* REPLACING old line(s) by new
' $linesize:132
' $title: 'RBBSSUB2.BAS 17.4, Copyright 1986 - 92 by D. Thomas Mack'
' Copyright 1991 by D. Thomas Mack, all rights reserved.
' Name ...............: RBBSSUB2.BAS
' First Released .....: June 21, 1992
' Subsequent Releases.:
' Copyright ..........: 1986 - 1992
' Purpose.............: The Remote Bulletin Board System for the IBM PC,
' RBBS-PC.BAS utilizes a lot of common subroutines. Those that do not
' require error trapping are incorporated within RBBSSUB 2-5 as
' separately callable subroutines in order to free up as much
' code as possible within the 64K code segment used by RBBS-PC.BAS.
' Parameters..........: Most parameters are passed via a COMMON statement.
'
' Subroutine Line Function of Subroutine
' Name Number
' Macro 1320 Check/execute macro
' AnswerIt 200 Answer the telephone when it rings
' ASCIICodes 129 Allow a CONFIG string to have any ASCII value
' BadChar 455 Check user name for invalid characters
' BadName 20235 Check for system crash attempt with bad file name
' BankTime 5500 Let caller change banked time
' CheckRatio 20096 Test upload/download ratio
' CheckMacro 1242 Checks for macro and processes
' CopyRight 97 Display RBBS-PC's copyright notice
' DEFALTU 9600 Write out the user's defaults
' DenyAccess 1386 Downgrade security so access denied
' DoorExit 10983 Set up a .BAT file to exit RBBS-PC to a "door"
' DoorInfo 10991 Writes out information for a door
' DosExit 10934 Set up a .BAT file to exit to DOS (second level)
' EditALine 2618 Edits a single line
' EditDef 120 Edit configuration parameters
' FileNameCheck 20240 Matches file name to a prefix & extension
' GetArc 20140 Handle request for verbose listing
' GetCommand 101 Get RBBS-PC's node id from command line
' GetTime 9140 Calculates callers elapsed time (hh,mm,ss)
' GoIdle 90 Release resources when waiting for keyboard input
' KillMsg 3952 Delete old or unnecessary messages
' Line25 945 Build and/or update line 25 of RBBS-PC's local screen
' LineEdit 3700 Edit a line while minimizing string space consumption
' LogError 13660 Log error message to CALLERS file
' LPrnt 1480 Subroutine to write to local display
' MLInit 8 Handle MultiLink initialization/de-initialization
' MsgProt 2055 Sets protection for a message
' ParseIt 1637 Parses a string
' PassWrd 660 Verify user & message passwords
' PopCmdStack 1650 Get user input, 1st checking command stack
' PScrn 1483 Print to display
' QuickLPrnt 1482 Quickly writes count of blocks on file transfer
' QuickTPut 1478 Fast, but limited, "TPut" equivalent
' QuickTPut1 1478 Outputs short string following by CR LF
' RBBSExit 10992 RBBS-PC exit to transfer control to other programs
' RecoverMsg 10410 Recover a deleted message
' RemNonAlf 5100 Removes non-alpha characters from a string
' RingCaller 1636 Ring caller's bell and put message in emphasis
' SetBaud 1654 Set baud rate in the 8250 chip of the RS232 interface
' SetCrLf 1496 Set up the necessary carriage return/line feed string
' SetSection 12000 Set the proper section prompts (main, file, util, libr)
' SetThread 4554 Set up request for threading thru messages
' SetWhoTo 2018 Sets who a message/personal upload is to
' SkipLine 1485 Write a # of blank lines to the communications port
' SearchCmd 1238 Searches list of commands in RBBS for a request
' SecViolation 1380 Process a security violation
' SysMenu 112 Displays sysop menu/status
' SysopChat 4773 Sysop and caller chat
' TestRel 336 Tests for Reliable connect
' TGet 1498 Read a line from the communications port
' TPut 1396 Write a line to the communications port
' Trim 105 Strip leading and trailing blanks from a string
' TrimTrail 107 Strip off specified string off end of another string
' UntilRight 12878 Ask a question until user says answer is right
' UpdateU 10600 Updates the user record on loging off/exiting RBBS-PC
' VarInit 109 Initialize system variables
' ViewHelp 1330 Processes help command
' WhoCheck 2250 Checks whether a user exists in user file
' WhosOn 9801 Report status of each node - who's on
' WordInFile 10976 Find a whole word within a file/menu
'
* ------[ first line different ]------
' PersonalRing Detects "Distinctive Ring" patterns from Phone Co.
' ' JR070101
' $INCLUDE: 'RBBS-VAR.BAS'
'
' $SUBTITLE: 'MLInit - MultiLink initialization/deinitialization'
' $PAGE
'
' NAME -- MLInit
'
' INPUTS -- MLParm = 1 INITIALIZE AT STARTUP OR RE-
' CYLCE TIME
' MLParm = 2 DE-INITIALIZE ON EXITING TO
' A DOOR OR DOS REMOTELY
' MLParm = 3 DE-QUEUE COMMUNICATIONS PORTS
' MLParm = 4 CHECK FOR MULTILINK PRESENT
' ZDoorsTermType
' ZBaudTest!
' ZComPort$
' ZComputerType
'
' OUTPUTS -- NONE
'
' PURPOSE -- To test for the presence of multi-link and set
' multi link options to be compatible with RBBS-PC
'
SUB MLInit (MLParm) STATIC
DEF SEG = 0
IF ZComputerType = 1 _
GOTO 10
IF NOT ZMLCom THEN _
IF ZNetworkType <> 1 THEN _
GOTO 10
ZMultiLinkPresent = PEEK(&H1FE) + 256 * PEEK(&H1FF)
IF ZMultiLinkPresent = 0 THEN _
GOTO 10
ON MLParm GOSUB 30,20,60,10
* REPLACING old line(s) by new
237 LOCATE 18,76
IF ZDosANSI THEN _
CALL LPrnt(ZEscape$ + "[05m" + "YES" + ZEscape$ + "[00m",0) _
ELSE CALL LPrnt ("YES",0)
COLOR ZFG,ZBG,ZBorder
LOCATE 20,56
'
'
' * GET READY TO ANSWER INCOMMING CALL:
' * 1. LET THE MODEM "AUTO-ANSWER" FOR RBBS-PC.
' * REQUIRED RINGS = 0 AND S0 = 1 IN MODEM INIT COMMAND.
' * 2. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS.
' * REQUIRED RINGS > 0 AND S0 = 254 IN MODEM Init COMMAND.
' * 3. ANSWER THE MODEM ON A SPECIFIED NUMBER OF RINGS AFTER A USER
' * First CALLS AND THEN HANGS UP (I.E. RING-BACK).
' * REQUIRED RINGS > 0 AND S0 = 255 IN MODEM INIT COMMAND.
'
'
WasQQ = 255
WasI = INSTR(ZModemInitCmd$,"S0")
IF WasI = 0 THEN _
GOTO 239
* ------[ first line different ]------
Sreg% = VAL(MID$(ZModemInitCmd$,WasI + 3,3)) ' JR070102
IF Sreg% = 255 THEN ' JR070103
WasQQ = 0 : _ ' JR070104
ZBlk = WasQQ ' JR070105
END IF ' JR070106
ZSecsUsedSession! = TIMER
ZSubParm = 1
CALL Line25
RingAnswer = ZTrue
IF RingBack THEN _
RingAnswer = ZFalse
* REPLACING old line(s) by new
266 IF (INP(ZModemStatusReg) AND &H40) > 0 AND _
* ------[ first line different ]------
ZRequiredRings > 0 THEN ' JR070107
IF Sreg% = 252 OR Sreg% = 253 THEN ' JR070108
PAnswer% = 0 ' JR070109
CALL PersonalRing(PAnswer%, Sreg%) ' JR070110
IF PAnswer% = 1 THEN ' JR070111
GOTO 276 ' JR070112
END IF ' JR070113
ELSE ' JR070114
GOTO 276
END IF ' JR070115
END IF ' JR070116
* REPLACING old line(s) by new
270 IF ZRecycleWait > 0 THEN _
CALL CheckTime(InactiveDelay!, TempElapsed!, 1) : _
IF TempElapsed! <= 0 THEN _
ZSubParm = 8 : _
EXIT SUB
* ------[ first line different ]------
IF Sreg% = 252 OR Sreg% = 253 THEN ' JR070117
IF PAnswer% = 0 THEN ' JR070118
CALL GoIdle ' JR070119
GOTO 247 ' JR070120
ELSE ' JR070121
GOTO 276 ' JR070122
END IF ' JR070123
END IF ' JR070124
CALL FlushCom (WasX$)
IF LEN(WasX$) > 0 THEN _
ModemResponse$ = ModemResponse$ + WasX$ : _
RingDetected = (INSTR(ModemResponse$,"RING") > 0) : _
ConnectDetected = (INSTR(ModemResponse$,"ONNECT") > 0) : _
NoCall = (NOT RingDetected) AND (NOT ConnectDetected)
IF RingDetected AND ZRequiredRings > 0 THEN _
MID$(ModemResponse$, INSTR(ModemResponse$,"RING")+1,1) = "A" : _
RingDetected = ZFalse : _
GOTO 276
CALL GoIdle
GOTO 247
* REPLACING old line(s) by new
20246 IF BaudTest! = 14400 THEN _
BPS = -9 _
ELSE IF BaudTest! = 16800 THEN _
BPS = -10 _
ELSE IF BaudTest! = 7200 THEN _
BPS = -6 _
ELSE IF BaudTest! = 12000 THEN _
BPS = -8 _
ELSE BPS = -7 ' 9600
END SUB
* ------[ first line different ]------
DEFINT A-Z ' JR070125
SUB PersonalRing (PAnswer%, Sreg%) STATIC ' JR070126
LOCATE 20, 36 ' JR070127
PRINT "PERSONAL RING" ' JR070128
ptimeout! = TIMER ' JR070129
DO ' JR070130
DetectedRing% = INP(ZModemStatusReg) AND &H40 ' JR070131
ptimeend! = TIMER ' JR070132
IF ptimeend! - ptimeout! > 5 THEN ' JR070133
LOCATE 20, 36 ' JR070134
PRINT " " ' JR070135
EXIT SUB ' JR070136
END IF ' JR070137
LOOP UNTIL DetectedRing% = 0 ' JR070138
ptimeout! = TIMER ' JR070139
DO ' JR070140
DetectedRing% = INP(ZModemStatusReg) AND &H40 ' JR070141
ptimeend! = TIMER ' JR070142
IF ptimeend! - ptimeout! > 5 THEN ' JR070143
LOCATE 20, 36 ' JR070144
PRINT " " ' JR070145
EXIT SUB ' JR070146
END IF ' JR070147
LOOP UNTIL DetectedRing% > 0 ' JR070148
RingStarted! = TIMER ' JR070149
ptimeout! = TIMER ' JR070150
DO ' JR070151
DetectedRing% = INP(ZModemStatusReg) AND &H40 ' JR070152
ptimeend! = TIMER ' JR070153
IF ptimeend! - ptimeout! > 5 THEN ' JR070154
LOCATE 20, 36 ' JR070155
PRINT " " ' JR070156
EXIT SUB ' JR070157
END IF ' JR070158
LOOP UNTIL DetectedRing% = 0 ' JR070159
RingStopped! = TIMER ' JR070160
RingLength! = RingStopped! - RingStarted! ' JR070161
IF Sreg% = 253 THEN ' JR070162
' Telephone Ring = Regular Ring... ' JR070163
IF RingLength! > 1.5 THEN ' JR070164
PAnswer% = 1 ' JR070165
END IF ' JR070166
' Telephone Ring = Short Ring... ' JR070167
ELSEIF Sreg% = 252 THEN ' JR070168
IF RingLength! < 1.3 THEN ' JR070169
PAnswer% = 1 ' JR070170
END IF ' JR070171
END IF ' JR070172
LOCATE 20, 36 ' JR070173
PRINT " " ' JR070174
END SUB ' JR070175